home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / calc.tcl < prev    next >
Encoding:
Text File  |  1997-11-18  |  5.2 KB  |  212 lines  |  [TEXT/ALFA]
  1.  
  2. ##########################################################################
  3. #                                                                         #
  4. #    Use    at your    own    risk. This is just a quick-and-dirty RPN stack         #
  5. #    calculator,    works on both decimal (signed and unsigned), hex         #
  6. #     integers, and floating point. I put it                                 #
  7. #    together for my    own    use, not yours,    but    feel free to use it    as         #
  8. #    long as    you    don't complain about what it doesn't do. Improvements,     #
  9. #    of course, are welcome.                                                 #
  10. #                                                                         #
  11. #    Operations:                                                             #
  12. #        +,-,*,/,|,&,%    Top    of stack is    'y', next is 'x'. Does x OP    y.     #
  13. #        ~                bitwise NOT                                         #
  14. #        ^                x eor y                                             #
  15. #        <                x << y                                             #
  16. #        >                x >> y                                             #
  17. #        c                change y's sign                                     #
  18. #        q                dup    y                                             #
  19. #        i                swap x and y                                     #
  20. #        m                switch decimal/hex modes                         #
  21. #        x                show current mode                                 #
  22. #        h,?                help                                             #
  23. #        <delete>        pop    stack                                         #
  24. #        <space>            enter number                                     #
  25. #                                                                         #
  26. #    The mode indicator indicates whether hex or dec is active.              #
  27. #    All calculations performed in signed decimal.                         #
  28. #                                                                         #
  29. ##########################################################################
  30.  
  31. alpha::mode Calc 0.1 Calc::dummy
  32.  
  33. # Alpha will shift this in and out of global scope as necessary
  34. newPref variable tcl_precision 17 Calc
  35.  
  36. proc Calc::dummy {} {}
  37.  
  38. proc calculator {} {
  39.     global tileLeft tileTop
  40.     if {[set ind [lsearch -exact [winNames] {* Calc *}]] >= 0} {
  41.         bringToFront {* Calc *}
  42.         return
  43.     }
  44.     set name [new -g $tileLeft $tileTop 200 200 -n {* Calc *} -m Calc]
  45.     catch {setWinInfo -w $name shell 1}
  46. }
  47.  
  48. ascii 0x2b "binop +"    Calc
  49. ascii 0x2d "binop -"    Calc
  50. ascii 0x2a "binop *"    Calc
  51. ascii 0x2f "binop /"    Calc
  52. ascii 0x7c "binop |"    Calc
  53. ascii 0x5e "binop ^"    Calc
  54. ascii 0x26 "binop &"    Calc
  55. ascii 0x25 "binop %"    Calc
  56. ascii 0x3e "binop >>"    Calc
  57. ascii 0x3c "binop <<"    Calc
  58. ascii 0x7e "unaryop ~"     Calc
  59. ascii 0x63 "unaryop -"    Calc
  60. ascii 0x3f "editMark \"$HOME:Help:Alpha Manual\" Calculator -r" Calc
  61. ascii 0x68 "editMark \"$HOME:Help:Alpha Manual\" Calculator -r" Calc
  62. ascii 0x71 calcDup        Calc
  63. ascii 0x69 calcEx        Calc
  64. ascii 0x6d changeCalcMode    Calc
  65. ascii 0x78 "calcShow"    Calc
  66. ascii 0x20 calcEnter    Calc
  67. ascii 0x08 calcDel        Calc
  68.  
  69. bind 'p' <o> "insertText {3.14159265358979323}" Calc
  70. bind 'e' <so> "insertText {2.718281828459045}" Calc
  71.  
  72. set calcMode 3
  73.  
  74. proc changeCalcMode {} {
  75.     global calcMode
  76.     
  77.     goto [maxPos]
  78.     if {[getPos]} {
  79.         if {[lookAt [expr [getPos] - 1]] != "\r"} calcEnter
  80.         set nums {}
  81.         set t ""
  82.         foreach n [split [getText 0 [expr [maxPos] - 1]] "\r"] {
  83.             lappend nums [calcGet $n]
  84.         }
  85.         set calcMode [expr ($calcMode + 1) % 4]
  86.         foreach n $nums {
  87.             append t "[calcPut $n]\r"
  88.         }
  89.         replaceText 0 [maxPos] $t
  90.     } else {
  91.         set calcMode [expr ($calcMode + 1) % 4]
  92.     }
  93.     switch "$calcMode" {
  94.         0     {message "Signed decimal" }
  95.         1     {message "Unsigned decimal"}
  96.         2     {message "Unsigned hexadecimal"}
  97.         3     {message "Floating Point"}
  98.     }
  99. }
  100.  
  101.  
  102. proc calcShow {} {
  103.     global calcMode
  104.     switch "$calcMode" {
  105.         0     {message "Signed decimal" }
  106.         1     {message "Unsigned decimal"}
  107.         2     {message "Unsigned hexadecimal"}
  108.         3     {message "Floating Point"}
  109.     }
  110. }
  111.  
  112.  
  113. proc calcGet {in} {
  114.     global calcMode
  115.  
  116.     switch "$calcMode" {
  117.         0    {scan $in "%d" num; return $num}
  118.         1    {scan $in "%u" num; return $num}
  119.         2    {scan $in "%x" num; return $num}
  120.         3    {scan $in "%f" num; return $num}
  121.     }
  122.     error "Bad hex num '$in'"
  123. }
  124.  
  125.  
  126. proc calcPut {in} {
  127.     global calcMode
  128.  
  129.     if {$calcMode != 3} {
  130.         regexp {[0-9-]+} $in in
  131.     }
  132.     switch $calcMode {
  133.         0         {return [format "%10d" $in]}
  134.         1         {return [format "%10u" $in]}
  135.         2         {return [format "%10x" $in]}
  136.         3         {return [format "%17.6f" $in]}
  137.     }
  138. }
  139.  
  140.         
  141. proc binop {op} {
  142.     global calcMode
  143.     goto [maxPos]
  144.     if {[lookAt [expr [getPos] - 1]] != "\r"} calcEnter
  145.     set pos [lineStart [getPos]]
  146.     set st_y [lineStart [expr $pos - 1]]
  147.     set st_x [lineStart [expr $st_y - 1]]
  148.     if {$st_y == $st_x} { beep; return}
  149.     set res [eval expr [calcGet [getText $st_x $st_y]] $op [calcGet [getText $st_y $pos]]]
  150.     replaceText $st_x [maxPos] "[calcPut $res]\r"
  151. }
  152.  
  153.  
  154. proc unaryop {op} {
  155.     goto [maxPos]
  156.     
  157.     set pos [getPos]
  158.     set last [lineStart [expr [getPos] - 1]]
  159.     replaceText $last $pos [expr "[calcPut $op[calcGet [getText $last $pos]]]"] "\r"
  160. }
  161.  
  162.  
  163. proc calcEx {} {
  164.     goto [maxPos]
  165.     if {[lookAt [expr [getPos] - 1]] != "\r"} calcEnter
  166.     set pos [lineStart [getPos]]
  167.     set st_y [lineStart [expr $pos - 1]]
  168.     set st_x [lineStart [expr $st_y - 1]]
  169.     if {$st_y == $st_x} { beep; return}
  170.     replaceText $st_x [maxPos] "[getText $st_y $pos][getText $st_x $st_y]"
  171. }
  172.  
  173.  
  174. proc calcEnter {} {
  175.     global calcMode
  176.     goto [maxPos]
  177.     switch "$calcMode" {
  178.         0     {set ex {[0-9-]+$}}
  179.         1     {set ex {[0-9]+$}}
  180.         2     {set ex {[0-9a-f]+$}}
  181.         3     {set ex {[0-9.-]+$}}
  182.     } 
  183.     if {[regexp $ex [getText [lineStart [getPos]] [getPos]] num]} {
  184.         set num [calcGet $num]
  185.         replaceText [lineStart [getPos]] [getPos] [calcPut $num] "\r"
  186.     } else {
  187.         beep
  188.         beginningOfLine
  189.         killLine
  190.     }
  191. }
  192.  
  193. proc calcDel {} {
  194.     goto [maxPos]
  195.     if {[lookAt [expr [getPos] - 1]] == "\r"} {
  196.         deleteText [lineStart [expr [getPos] - 1]] [getPos]
  197.     } else {
  198.         backSpace
  199.     }
  200. }
  201.  
  202. proc calcDup {} {
  203.     goto [maxPos]
  204.     if {[lookAt [expr [getPos] - 1]] != "\r"} calcEnter
  205.     set to [lineStart [getPos]]
  206.     set from [lineStart [expr $to - 1]]
  207.     set t [getText $from $to]
  208.     insertText $t
  209. }
  210.  
  211.  
  212.